perm filename M11C.F4[M11,LCS]3 blob
sn#400665 filedate 1978-11-30 generic text, type T, neo UTF8
00100 CFORS3 FORTRAN UNIT GENERATOR ROUTINE
00200 C *** MUSIC V ***
00300 SUBROUTINE FORSAM
00400 REAL IN1,IN2,IN3,IN4
00500 COMMON /LM/L(10),M(10),NSAMX,XNFUN
00600 C CAN USE UP TO 10 FIELDS IN UNIT GEN.
00700 COMMON I(1) /P/P(1) /GENS/GENS(1) /IRAN/IRAN /LFUNC/LFUNC
00800 COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
00900 C INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
01000 EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
01100 1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
01200 2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8))
01300 XNFUN=LFUNC-1
01400 C COMMON INITIALIZATION OF GENERATORS
01500 N1=I(6)+2
01600 N2=INS(N1-1)-1
01700 DO 204 J1=N1,N2
01800 J2=J1-N1+1
01900 IF(INS(J1).GE.0)GO TO 201
02000 200 L(J2)=-INS(J1)
02100 M(J2)=1
02200 GO TO 204
02300 201 M(J2)=0
02400 IF(INS(J1)-26262.GT.0)GO TO 203
02500 C***** WHAT DOES THE BIG NUMBER DO?????
02600 C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
02700 202 L(J2)=INS(J1)+I(3)-1
02800 GO TO 204
02900 203 L(J2)=I(J1)-26262
03000 C****** WHAT DOES THIS BIG NUM. DO?? ***********
03100 204 CONTINUE
03200 NSAM=I(5)
03300 NSAMX=NSAM-1
03400 N3=INS(N1-2)
03500 NGEN= N3 -100
03600 GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
03700 IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
03800 C FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
03900 C SUBROUTINE OPT(L,M,NSAM)
04000 C DIMENSION L(8),M(8)
04100 C COMMON /GENS/GENS(1)/IRAN/IRAN/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
04200 112 RETURN
04300
04400 C UNIT GENERATORS
04500 C OUTPUT BOX
04600 CX 101 IF(M1.LE.0)IN1=RNT(L1)
04700 CX DO 270 J3=0,NSAM-1
04800 CX IF(M1.GT.0)IN1=ROUT(J3+L1)
04900 CX 265 J5=L2+J3
05000 CX ROUT(J5)=IN1+ROUT(J5)
05100 CX 270 CONTINUE
05200 CX RETURN
05250 101 CALL OUTP
05275 C CALLS 'FAIL' OUT BOX
05287 RETURN
05300 CC101 DO 270 K=0,NSAMX
05400 J5=L2+K
05500 270 ROUT(J5)=ROUT(J5)+ROUT(K+L1)
05600 RETURN
05700 C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
05800 C THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
05900
06000 C OSCILLATOR L1,L2 = P or B L3=B L4=F L5=P
06100 C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
06150 102 CALL OSC
06162 C CALL 'FAIL' OSC.
06175 RETURN
06200 CCC 102 SUM=RNT(L5)
06300 IF(M1.LE.0)AMP=RNT(L1)
06400 IF(M2.LE.0)FREQ=RNT(L2)
06500 DO 293 J3=0,NSAMX
06600 J4=INT(SUM)+L4
06700 F=GENS(J4)
06800 C GENS(J4) IS IN FUNC STORAGE AREA.
06900 IF(M2.GT.0)GO TO 286
07000 SUM=SUM+FREQ
07100 GO TO 290
07200 286 J4=L2+J3
07300 SUM=SUM+ROUT(J4)
07400 290 IF(SUM.GE.XNFUN)GO TO 287
07500 IF(SUM.LT.0.0)GO TO 289
07600 288 J5=L3+J3
07700 IF(M1.GT.0)GO TO 292
07800 ROUT(J5)=AMP*F
07900 GO TO 293
08000 C**********
08100 287 SUM=SUM-XNFUN
08200 GO TO 288
08300 289 SUM=SUM+XNFUN
08400 GO TO 288
08500 C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
08600 292 J6=L1+J3
08700 ROUT(J5)=ROUT(J6)*F
08800 293 CONTINUE
08900 RNT(L5)=SUM
09000 C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
09100 RETURN
09200
09300 C ADD TWO BOX
09400 C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
09500 103 IF(M1.LE.0)XIN1=RNT(L1)
09600 IF(M2.LE.0)XIN2=RNT(L2)
09700 DO 258 J3=0,NSAMX
09800 IF(M1.GT.0)XIN1=ROUT(J3+L1)
09900 IF(M2.GT.0)XIN2=ROUT(L2+J3)
10000 ROUT(J3+L3)=XIN1+XIN2
10100 258 CONTINUE
10200 RETURN
10300
10400 C RANDOM INTERPOLATING GENERATOR RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
10500 C M1=0=Pn M1=1=Bn
10600 104 SUM=RNT(L4)
10700 IF(M1.LE.0)XIN1=RNT(L1)
10800 IF(M2.LE.0)XIN2=RNT(L2)
10900 313 RN1=RNT(L5)
11000 RN3=RNT(L6)
11100 DO 340 J3=0,NSAMX
11200 IF(M1.GT.0)XIN1=ROUT(J3+L1)
11300 IF(M2.GT.0)XIN2=ROUT(J3+L2)
11400 IF(SUM-XNFUN.LT.0)GO TO 320
11500 SUM=SUM-XNFUN
11600 IRAN=IABS (IRAN*IMULT)
11700 RN4=(2.*FLOAT(IRAN)-1.)
11800 RN2=RN4-RN3
11900 RN1=RN3
12000 RN3=RN4
12100 GO TO 321
12200 320 RN2=RN3-RN1
12300 321 ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)
12400 SUM=SUM+XIN2
12500 340 CONTINUE
12600 RNT(L4)=SUM
12700 RNT(L5)=RN1
12800 RNT(L6)=RN3
12900 RETURN
13000
13100 C ENVELOPE GENERATOR ENV PorB, F, B, P, P, P, P;
13200 C AMP FUN OUT AT ST DC STO
13300 105 SUM=RNT(L7)
13400 XIN4=RNT(L4)
13500 XIN5=RNT(L5)
13600 XIN6=RNT(L6)
13700 XIN5=1./(1./XIN5 - 1./XIN4 -1./XIN6 )
13800 C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
13900 C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
14000 C STEADY STATE TIME IS COMPUTED
14100 IF(M1.LE.0)AMP =RNT(L1)
14200 CX IF(M4.LE.0)XIN4=FLOAT(RNT(L4))*SFI
14300 CX IF(M5.LE.0)XIN5=FLOAT(RNT(L5))*SFI
14400 CX IF(M6.LE.0)XIN6=FLOAT(RNT(L6))*SFI
14500 XIN4=XIN4/4.
14600 XIN5=XIN5/4.
14700 XIN6=XIN6/4.
14800 387 X1=XNFUN/4.
14900 X2=2.*X1
15000 X3=3.*X1
15100 DO 403 J3=0,NSAMX
15200 J4=INT(SUM)+L2
15300 F=GENS(J4)
15400 IF(M1.GT.0)AMP =ROUT(J3+L1)
15500 IF(SUM-XNFUN.GE.0)SUM=SUM-XNFUN
15600 IF(SUM-X1.GT.0)GO TO 393
15700 CX IF(M4.GT.0)XIN4=FLOAT(ROUT(J3+L4))
15800 SUM=SUM+XIN4
15900 GO TO 402
16000 393 IF(SUM-X2.GT.0)GO TO 397
16100 CX IF(M5.GT.0)XIN5=FLOAT(ROUT(J3+L5))
16200 SUM=SUM+XIN5
16300 GO TO 402
16400 CX397 IF(M6.GT.0)XIN6=FLOAT(ROUT(J3+L6))
16500 397 SUM=SUM+XIN6
16600 402 J7=L3+J3
16700 ROUT(J7)=AMP*F
16800 403 CONTINUE
16900 RNT(L7)=SUM
17000 RETURN
17100
17200 C STEREO OUTPUT BOX L1,L2 = B L3=B1
17300 C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
17400 106 NSSAM=2*NSAM
17500 C 6/29/70 L.C.SMITH
17600 ICT=0
17700 DO 510 J3=1,NSSAM,2
17800 J4=L1+ICT
17900 XIN1=ROUT(J4)
18000 505 J5=L3+J3-1
18100 ROUT(J5)=XIN1+ROUT(J5)
18200 506 J4=L2+ICT
18300 XIN2=ROUT(J4)
18400 507 J5=L3+J3
18500 ROUT(J5)=XIN2+ROUT(J5)
18600 510 ICT=ICT+1
18700 RETURN
18800 C STEREO OUTPUT BOX
18900 CX106 IF(M1.GT.0)GO TO 501
19000 CCC 106 IF(M1)500,500,501
19100 CX 500 IN1=I(L1)
19200 CX501 IF(M2.GT.0)GO TO 503
19300 CCC 501 IF(M2)502,502,503
19400 CX 502 IN2=I(L2)
19500 CX 503 NSSAM=2*NSAM
19600 C 6/29/70 L.C.SMITH
19700 CX ICT=0
19800 CX DO 510 J3=1,NSSAM,2
19900 CX IF(M1.LE.0)GO TO 505
20000 CCC IF(M1)505,505,504
20100 CC*** 504 J4=L1+J3-1
20200 CX504 J4=L1+ICT
20300 CX IN1=I(J4)
20400 CX 505 J5=L3+J3-1
20500 CX I(J5)=IN1+I(J5)
20600 CX IF(M2.LE.0)GO TO 507
20700 CCC IF(M2)507,507,506
20800 CC*** 506 J4=L2+J3-1
20900 CX506 J4=L2+ICT
21000 CX IN2=I(J4)
21100 CX 507 J5=L3+J3
21200 CX I(J5)=IN2+I(J5)
21300 CX 510 ICT=ICT+1
21400 CX RETURN
21500
21600 C ADD 3 BOX
21700 107 IF(M1.LE.0)XIN1=RNT(L1)
21800 IF(M2.LE.0)XIN2=RNT(L2)
21900 IF(M3.LE.0)XIN3=RNT(L3)
22000 DO 780 J3=0,NSAMX
22100 IF(M1.GT.0)XIN1=ROUT(L1+J3)
22200 IF(M2.GT.0)XIN2=ROUT(L2+J3)
22300 IF(M3.GT.0)XIN3=ROUT(L3+J3)
22400 ROUT(J3+L4)=XIN1+XIN2+XIN3
22500 780 CONTINUE
22600 RETURN
22700
22800 C ADD 4 BOX
22900 108 IF(M1.LE.0)XIN1=RNT(L1)
23000 IF(M2.LE.0)XIN2=RNT(L2)
23100 IF(M3.LE.0)XIN3=RNT(L3)
23200 IF(M4.LE.0)XIN4=RNT(L4)
23300 DO 880 K=0,NSAMX
23400 IF(M1.GT.0)XIN1=ROUT(L1+K)
23500 859 IF(M2.GT.0)XIN2=ROUT(L2+K)
23600 IF(M3.GT.0)XIN3=ROUT(L3+K)
23700 863 IF(M4.GT.0)XIN4=ROUT(L4+K)
23800 ROUT(L5+K)=XIN1+XIN2+XIN3+XIN4
23950 880 CONTINUE
24000 RETURN
24100
24200 C MULTIPLIER
24300 109 IF(M1.LE.0)XIN1=RNT(L1)
24400 IF(M2.LE.0)XIN2=RNT(L2)
24500 DO 908 J3=0,NSAMX
24600 IF(M1.GT.0)XIN1=ROUT(J3+L1)
24700 IF(M2.GT.0)XIN2=ROUT(J3+L2)
24800 ROUT(J3+L3)=XIN1*XIN2
24900 908 CONTINUE
25000 RETURN
25100
25200 C SET NEW FUNCTION IN OSC OR ENV
25300 110 ILOC=N1+6
25400 IF(INS(N1+1).EQ.105) ILOC=N1+4
25500 JN1=I(3)+INS(N1)-1
25600 IIN1=RNT(JN1)
25700 IF(IIN1.GT.0) INS(ILOC)=-(IIN1-1)*LFUNC-1
25900 RETURN
26000
26100 C RANDOM AND HOLD GENERATOR RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
26200 C M1=0=Pn M1=1=Bn
26300 111 SUM=ROUT(L4)
26400 IF(M1.LE.0)XIN1=RNT(L1)
26500 IF(M2.LE.0)XIN2=RNT(L2)
26600 913 RN=RNT(L5)
26700 DO 940 J3=0,NSAMX
26800 IF(M1.GT.0) XIN1=ROUT(J3+L1)
26900 IF(M2.GT.0) XIN2=ROUT(J3+L2)
27000 IF(SUM-XNFUN.LT.0)GO TO 920
27100 SUM=SUM-XNFUN
27200 IRAN=IABS (IRAN*IMULT)
27300 RN=(2.*FLOAT(IRAN)-1.)
27400 920 ROUT(J3+L3)=XIN1*RN
27500 SUM=SUM+XIN2
27600 940 CONTINUE
27700 RNT(L4)=SUM
27800 RNT(L5)=RN
27900 RETURN
28000 END
28100
28200 SUBROUTINE OPT(L,M,NSAM)
28300 DIMENSION L(1),M(1)
28400 COMMON /GENS/GENS(1)/IRAN/IRAN/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
28500 C THIS IS A DUMMY ROUTINE OPT Pm Pn Bn; doubles value of Bn
28600 J1=L(3)
28700 C L(3) MEANS LOOK AT 3RD FIELD OF 'OPT'
28800 J2=J1+NSAM-1
28900 DO 1 K=J1,J2
29000 1 ROUT(K)=ROUT(K)*2
29100 RETURN
29200 END